Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

50

Games Picked

76

Number of predictions

78

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 Washington Commanders Chicago Bears No 6 0.0769
2 Buffalo Bills Jacksonville Jaguars No 7 0.0897
3 Baltimore Ravens Pittsburgh Steelers No 12 0.1538
4 Detroit Lions Detroit Lions Yes 78 1.0000
5 Houston Texans Atlanta Falcons No 26 0.3333
6 New Orleans Saints New Orleans Saints Yes 48 0.6154
7 Miami Dolphins Miami Dolphins Yes 78 1.0000
8 Indianapolis Colts Indianapolis Colts Yes 42 0.5385
9 Cincinnati Bengals Cincinnati Bengals Yes 45 0.5769
10 Philadelphia Eagles Philadelphia Eagles Yes 67 0.8590
11 Kansas City Chiefs Kansas City Chiefs Yes 74 0.9487
12 New York Jets New York Jets Yes 41 0.5256
13 San Francisco 49ers San Francisco 49ers Yes 66 0.8462
14 Green Bay Packers Las Vegas Raiders No 18 0.2308

Individual Predictions

row

Individual Table

Individual Results
Week 5
Name Weekly # Correct Percent Weeks Picked Season Percent Adj Season Percent Season Trend
Week 1 Week 2 Week 3 Week 4 Week 5
Antonio Mitchell 10 12 NA 11 10 0.7143 4 0.6935 0.5548
Anthony Bloss 8 10 11 12 10 0.7143 5 0.6711 0.6711
James Tierney 9 10 NA 10 10 0.7143 4 0.6290 0.5032
DERRICK ELAM 6 9 11 10 10 0.7143 5 0.6053 0.6053
Anthony Brinson 10 11 8 6 10 0.7143 5 0.5921 0.5921
Robert Lynch 9 9 6 10 10 0.7143 5 0.5789 0.5789
Melissa Printup 8 NA 8 7 10 0.7143 4 0.5500 0.4400
MICHAEL BRANSON 8 11 10 12 9 0.6429 5 0.6579 0.6579
Cherylynn Vidal 10 9 9 12 9 0.6429 5 0.6447 0.6447
Aubrey Conn 9 12 8 11 9 0.6429 5 0.6447 0.6447
George Mancini 7 12 10 10 9 0.6429 5 0.6316 0.6316
Jason Schattel 7 10 9 11 9 0.6429 5 0.6053 0.6053
Bunnaro Sun 9 10 9 8 9 0.6429 5 0.5921 0.5921
Amy Asberry 8 9 10 9 9 0.6429 5 0.5921 0.5921
Matthew Schultz 8 NA 10 8 9 0.6429 4 0.5833 0.4666
Charlene Redmer 9 9 NA 9 9 0.6429 4 0.5806 0.4645
Robert Gelo 6 9 10 10 9 0.6429 5 0.5789 0.5789
Robert Martin 10 9 6 NA 9 0.6429 4 0.5667 0.4534
Justin Thrift 9 8 9 8 9 0.6429 5 0.5658 0.5658
Montee Brown 7 NA NA 9 9 0.6429 3 0.5435 0.3261
Brandon Parks 8 8 NA NA 9 0.6429 3 0.5435 0.3261
Steven Webster 8 8 6 8 9 0.6429 5 0.5132 0.5132
Justin Crick 11 11 11 13 8 0.5714 5 0.7105 0.7105
Ronald Schmidt 11 13 11 8 8 0.5714 5 0.6711 0.6711
Chris Papageorge 11 11 11 10 8 0.5714 5 0.6711 0.6711
Sarah Sweet 9 12 12 9 8 0.5714 5 0.6579 0.6579
Ramar Williams NA 11 11 9 8 0.5714 4 0.6500 0.5200
Bradley Hobson 8 10 11 12 8 0.5714 5 0.6447 0.6447
William Schouviller 10 9 11 10 8 0.5714 5 0.6316 0.6316
Paul Presti 9 10 12 9 8 0.5714 5 0.6316 0.6316
Rahmatullah Sharifi 11 9 8 11 8 0.5714 5 0.6184 0.6184
Kevin Green 9 12 9 9 8 0.5714 5 0.6184 0.6184
Eric Hahn 9 13 7 9 8 0.5714 5 0.6053 0.6053
Brian Hollmann 8 13 8 9 8 0.5714 5 0.6053 0.6053
James Small 8 8 13 9 8 0.5714 5 0.6053 0.6053
Daniel Baller 6 12 11 9 8 0.5714 5 0.6053 0.6053
WAYNE SCHOFIELD 12 9 7 NA 8 0.5714 4 0.6000 0.4800
Shelly Bailey 9 10 NA 10 8 0.5714 4 0.5968 0.4774
Steven Curtis NA NA 11 7 8 0.5714 3 0.5909 0.3545
Gregory Flint 6 11 NA 11 8 0.5714 4 0.5806 0.4645
Shawn Carden 9 12 6 9 8 0.5714 5 0.5789 0.5789
Thomas Brenstuhl 10 NA 8 8 8 0.5714 4 0.5667 0.4534
Karen Coleman 7 10 NA 10 8 0.5714 4 0.5645 0.4516
Daniel Major 8 13 6 7 8 0.5714 5 0.5526 0.5526
THOMAS MCCOY 8 10 9 7 8 0.5714 5 0.5526 0.5526
DAVID PLATE 8 NA 8 9 8 0.5714 4 0.5500 0.4400
Michael Moss 10 NA 11 13 7 0.5000 4 0.6833 0.5466
Kevin O'NEILL 8 11 11 13 7 0.5000 5 0.6579 0.6579
Ryan Wiggins 8 11 11 12 7 0.5000 5 0.6447 0.6447
George Sweet 9 11 10 12 7 0.5000 5 0.6447 0.6447
Kevin Kehoe 9 10 11 12 7 0.5000 5 0.6447 0.6447
PABLO BURGOSRAMOS 9 11 10 12 7 0.5000 5 0.6447 0.6447
Manuel Vargas 10 9 11 12 7 0.5000 5 0.6447 0.6447
Vincent Scannelli 11 11 8 11 7 0.5000 5 0.6316 0.6316
Paul Shim 10 9 10 11 7 0.5000 5 0.6184 0.6184
Terry Hardison 10 10 9 11 7 0.5000 5 0.6184 0.6184
Yiming Hu 9 10 8 12 7 0.5000 5 0.6053 0.6053
Brian Patterson 10 10 8 11 7 0.5000 5 0.6053 0.6053
Cody Koerwitz 7 9 11 12 7 0.5000 5 0.6053 0.6053
Walter Archambo 7 10 10 11 7 0.5000 5 0.5921 0.5921
Khalil Ibrahim 7 12 9 NA 7 0.5000 4 0.5833 0.4666
Patrick Tynan 8 8 10 11 7 0.5000 5 0.5789 0.5789
Jonathon Leslein 9 9 9 9 7 0.5000 5 0.5658 0.5658
Stephen Bush 7 10 10 9 7 0.5000 5 0.5658 0.5658
Shaun Dahl 8 8 10 10 7 0.5000 5 0.5658 0.5658
Daniel Kuehl 6 10 8 11 7 0.5000 5 0.5526 0.5526
Min Choi 6 7 9 11 7 0.5000 5 0.5263 0.5263
Ryan Cvik 11 11 9 13 6 0.4286 5 0.6579 0.6579
Gabriel Quinones 9 11 12 12 6 0.4286 5 0.6579 0.6579
Cheryl Brown 10 12 11 9 6 0.4286 5 0.6316 0.6316
Kristen White 7 13 8 11 6 0.4286 5 0.5921 0.5921
William Sherman 8 11 10 10 6 0.4286 5 0.5921 0.5921
Pamela AUGUSTINE 11 13 6 9 6 0.4286 5 0.5921 0.5921
Trevor MACGAVIN 6 10 8 NA 6 0.4286 4 0.5000 0.4000
Derrick Zantt 11 6 7 NA 6 0.4286 4 0.5000 0.4000
Ryan Shipley 3 8 7 6 6 0.4286 5 0.3947 0.3947
Earl Dixon 9 11 8 12 5 0.3571 5 0.5921 0.5921
Alexander Santillan 5 NA 8 9 5 0.3571 4 0.4500 0.3600
James Blejski 8 11 10 14 NA 0.0000 4 0.6935 0.5548
Michael Edmunds 10 12 10 10 NA 0.0000 4 0.6774 0.5419
Stephen Woolwine 8 13 9 NA NA 0.0000 3 0.6522 0.3913
David Spielman 8 NA 11 NA NA 0.0000 2 0.6333 0.2533
Carlos Caceres 10 NA NA NA NA 0.0000 1 0.6250 0.1250
John Plaster 8 12 8 10 NA 0.0000 4 0.6129 0.4903
Rafael Torres 6 8 12 11 NA 0.0000 4 0.5968 0.4774
Daniel Halse 8 9 10 NA NA 0.0000 3 0.5870 0.3522
Donald Park 8 12 7 9 NA 0.0000 4 0.5806 0.4645
Jamal Willis 8 10 NA NA NA 0.0000 2 0.5625 0.2250
Jason James 9 NA NA NA NA 0.0000 1 0.5625 0.1125
Michael Beck 9 NA NA NA NA 0.0000 1 0.5625 0.1125
Keithon Corpening 8 NA NA NA NA 0.0000 1 0.5000 0.1000
TYREE BUNDY 8 8 NA NA NA 0.0000 2 0.5000 0.2000
Edward Ford 6 8 NA NA NA 0.0000 2 0.4375 0.1750

Individual Plots

Season Leaderboard
Week 5
Season Rank Name Donuts Donuts Won Season Percent Adj Season Percent Season Trend
1 Justin Crick 0 0.7105 0.7105
2 Anthony Bloss 1 award, 0.6711 0.6711
2 Chris Papageorge 0 0.6711 0.6711
2 Ronald Schmidt 1 award, 0.6711 0.6711
5 Gabriel Quinones 0 0.6579 0.6579
5 Kevin O'NEILL 0 0.6579 0.6579
5 MICHAEL BRANSON 0 0.6579 0.6579
5 Ryan Cvik 0 0.6579 0.6579
5 Sarah Sweet 0 0.6579 0.6579
10 Aubrey Conn 0 0.6447 0.6447
10 Bradley Hobson 0 0.6447 0.6447
10 Cherylynn Vidal 0 0.6447 0.6447
10 George Sweet 0 0.6447 0.6447
10 Kevin Kehoe 0 0.6447 0.6447
10 Manuel Vargas 0 0.6447 0.6447
10 PABLO BURGOSRAMOS 0 0.6447 0.6447
10 Ryan Wiggins 0 0.6447 0.6447
18 Cheryl Brown 0 0.6316 0.6316
18 George Mancini 0 0.6316 0.6316
18 Paul Presti 0 0.6316 0.6316
18 Vincent Scannelli 0 0.6316 0.6316
18 William Schouviller 0 0.6316 0.6316
23 Kevin Green 0 0.6184 0.6184
23 Paul Shim 0 0.6184 0.6184
23 Rahmatullah Sharifi 0 0.6184 0.6184
23 Terry Hardison 0 0.6184 0.6184
27 Brian Hollmann 1 award, 0.6053 0.6053
27 Brian Patterson 0 0.6053 0.6053
27 Cody Koerwitz 0 0.6053 0.6053
27 DERRICK ELAM 1 award, 0.6053 0.6053
27 Daniel Baller 0 0.6053 0.6053
27 Eric Hahn 1 award, 0.6053 0.6053
27 James Small 1 award, 0.6053 0.6053
27 Jason Schattel 0 0.6053 0.6053
27 Yiming Hu 0 0.6053 0.6053
36 Amy Asberry 0 0.5921 0.5921
36 Anthony Brinson 1 award, 0.5921 0.5921
36 Bunnaro Sun 0 0.5921 0.5921
36 Earl Dixon 0 0.5921 0.5921
36 Kristen White 1 award, 0.5921 0.5921
36 Pamela AUGUSTINE 1 award, 0.5921 0.5921
36 Walter Archambo 0 0.5921 0.5921
36 William Sherman 0 0.5921 0.5921
44 Patrick Tynan 0 0.5789 0.5789
44 Robert Gelo 0 0.5789 0.5789
44 Robert Lynch 1 award, 0.5789 0.5789
44 Shawn Carden 0 0.5789 0.5789
48 Jonathon Leslein 0 0.5658 0.5658
48 Justin Thrift 0 0.5658 0.5658
48 Shaun Dahl 0 0.5658 0.5658
48 Stephen Bush 0 0.5658 0.5658
52 Antonio Mitchell 1 award, 0.6935 0.5548
52 James Blejski 1 award, 0.6935 0.5548
54 Daniel Kuehl 0 0.5526 0.5526
54 Daniel Major 1 award, 0.5526 0.5526
54 THOMAS MCCOY 0 0.5526 0.5526
57 Michael Moss 0 0.6833 0.5466
58 Michael Edmunds 0 0.6774 0.5419
59 Min Choi 0 0.5263 0.5263
60 Ramar Williams 0 0.6500 0.5200
61 Steven Webster 0 0.5132 0.5132
62 James Tierney 1 award, 0.6290 0.5032
63 John Plaster 0 0.6129 0.4903
64 WAYNE SCHOFIELD 1 award, 0.6000 0.4800
65 Rafael Torres 0 0.5968 0.4774
65 Shelly Bailey 0 0.5968 0.4774
67 Khalil Ibrahim 0 0.5833 0.4666
67 Matthew Schultz 0 0.5833 0.4666
69 Charlene Redmer 0 0.5806 0.4645
69 Donald Park 0 0.5806 0.4645
69 Gregory Flint 0 0.5806 0.4645
72 Robert Martin 0 0.5667 0.4534
72 Thomas Brenstuhl 0 0.5667 0.4534
74 Karen Coleman 0 0.5645 0.4516
75 DAVID PLATE 0 0.5500 0.4400
75 Melissa Printup 1 award, 0.5500 0.4400
77 Derrick Zantt 0 0.5000 0.4000
77 Trevor MACGAVIN 0 0.5000 0.4000
79 Ryan Shipley 0 0.3947 0.3947
80 Stephen Woolwine 1 award, 0.6522 0.3913
81 Alexander Santillan 0 0.4500 0.3600
82 Steven Curtis 0 0.5909 0.3545
83 Daniel Halse 0 0.5870 0.3522
84 Brandon Parks 0 0.5435 0.3261
84 Montee Brown 0 0.5435 0.3261
86 David Spielman 0 0.6333 0.2533
87 Jamal Willis 0 0.5625 0.2250
88 TYREE BUNDY 0 0.5000 0.2000
89 Edward Ford 0 0.4375 0.1750
90 Carlos Caceres 0 0.6250 0.1250
91 Jason James 0 0.5625 0.1125
91 Michael Beck 0 0.5625 0.1125
93 Keithon Corpening 0 0.5000 0.1000

Season Leaderboard

Data

---
title: "2023 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    orientation: rows
    vertical_layout: fill
    social: ["menu"]
    source_code: embed
    navbar:
      - { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer"  }
---


```{r setup, include=FALSE}
#    source_code: embed
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")

thematic::thematic_rmd(font = "auto")

```

```{r Reading in our picks files, include=FALSE}
current_week = 5 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2023 NFL Week 1.csv")
week_2 = read_csv("./CSV_Data_Files/2023 NFL Week 2.csv")
week_3 = read_csv("./CSV_Data_Files/2023 NFL Week 3.csv")
week_4 = read_csv("./CSV_Data_Files/2023 NFL Week 4.csv")
week_5 = read_csv("./CSV_Data_Files/2023 NFL Week 5.csv")
# week_6 = read_csv("./CSV_Data_Files/2023 NFL Week 6.csv")
# week_7 = read_csv("./CSV_Data_Files/2023 NFL Week 7.csv")
# week_8 = read_csv("./CSV_Data_Files/2023 NFL Week 8.csv")
# week_9 = read_csv("./CSV_Data_Files/2023 NFL Week 9.csv")
# week_10 = read_csv("./CSV_Data_Files/2023 NFL Week 10.csv")
# week_11 = read_csv("./CSV_Data_Files/2023 NFL Week 11.csv")
# week_12 = read_csv("./CSV_Data_Files/2023 NFL Week 12.csv")
# week_13 = read_csv("./CSV_Data_Files/2023 NFL Week 13.csv")
# week_14 = read_csv("./CSV_Data_Files/2023 NFL Week 14.csv")
# week_15 = read_csv("./CSV_Data_Files/2023 NFL Week 15.csv")
# week_16 = read_csv("./CSV_Data_Files/2023 NFL Week 16.csv")
# week_17 = read_csv("./CSV_Data_Files/2023 NFL Week 17.csv")
# week_18 = read_csv("./CSV_Data_Files/2023 NFL Week 18.csv")
# week_19 = read_csv("./CSV_Data_Files/2023 NFL Wild Card.csv")
# week_20 = read_csv("./CSV_Data_Files/2023 NFL Divisional Round.csv")
# week_21 = read_csv("./CSV_Data_Files/2023 NFL Conference Round.csv")
# week_22 = read_csv("./CSV_Data_Files/2023 NFL Super Bowl.csv")

#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv")) 

#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>% 
  mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))

#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))

#Odds not working for the 2023 season.  Need to fix scrape code for next year.
#Reading in the moneyline odds for each team and cleaning the team names
# odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
# odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
# odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
# odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
# odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
# odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
# odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
# odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
# odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
# odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
# odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
# odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
# odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
# odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
# odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
# odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
# odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
# odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
# odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
# odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
# odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
# odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))

####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3, week_4, week_5) #, week_6, week_7, week_8, week_9, week_10, week_11, week_12, week_13, week_14, week_15, week_16, week_17, week_18, week_19, week_20, week_21) #add in the additional weeks
# odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7, odds_wk8,
#              odds_wk9, odds_wk10, odds_wk11, odds_wk12) #add in the additional weeks
####################END OF UPDATE##############################

weeks = as.list(seq(1:current_week)) #creating a list of each week number
```

```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
# cl_odds = odds_cleaning(odds)

#Cleaning scores data
Scores = cleaning2(Scores)

#creating a list of winners for each week
winners = map(weeks, weekly_winners)

#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])  

#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```

```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)

#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```


```{r Displaying Group Results, echo=FALSE}
#Displaying the group results

inst_group_table = results[[length(results)]] %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    #subtitle = md(glue("Week {length(results)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="No"
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="Yes"
    )) %>% 
  tab_options(
    data_row.padding = px(3),
    container.height = "100%"
   )
```

```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage     

#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)  

#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)

#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)

#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)

#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)

#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))

#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))

#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```

```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>% 
  rename(`Win Percentage` = ".") %>% 
  add_column(Week = unlist(weeks))
```

```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>% 
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
  geom_point()+
  geom_path(aes(x = Week))+
  ylim(c(0, 1)) +
  xlab("NFL Week") + 
  ylab("Correct Percentage")+
  ggtitle("Weekly Group Correct Percentage")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5, size = 18))
```

```{r beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```

```{r beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```

```{r beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_total = map(espn_weekly_percent, experts_tot)
```

```{r beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_season_total = map(espn_season_percent, experts_tot)
```

```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)

#Combining each week into one dataframe and calculating percentage Correct for this week.  
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>% 
  mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4)) 

#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))

#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = ifelse(is.na(a[i,j])==T,0,1)
    tot_week[i] = sum(help)
  }
}

#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
    tot_picks[i] = sum(help)
  }
}

#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
  tot_correct[i] = sum(a[i,], na.rm = T)
}

#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
  add_column(tot_correct)%>%
  add_column(tot_picks)%>%
  mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
  mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
  select(-tot_correct, -tot_picks) %>%
  arrange(desc(Percent), desc(`Season Percent`)) %>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```


```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")

weekly_indiv_percent_plot = weekly_indiv_percent %>% 
  pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>% 
  mutate(Week = as.factor(Week))

levels = NULL
for(i in 1:length(weeks)){
  levels[i] = glue("Week {i}")  
}

weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
  mutate(Week = factor(Week, levels))
```

```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
  plot_object = 
    ggplot(data = df,
           aes(x = as.factor(Week), y=Percent, group = 1))+
    geom_path(size = 7)+
    scale_y_continuous(limits = c(0,1))+
    theme_void()+
    theme(legend.position = "none")
  return(plot_object)
}

sparklines = 
  weekly_indiv_percent_plot %>% 
  group_by(Name) %>% 
  nest() %>% 
  mutate(plot = map2(Name, data, plot_group)) %>% 
  select(-data)
  
indiv_disp_2 = indiv_disp %>% 
  inner_join(sparklines, by = "Name") %>% 
  mutate(`Season Trend` = NA)
```

```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Individual Results"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent>.5
    )) %>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(c(plot))

indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```

```{r Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(Donuts = sum(Donut)) %>% 
  mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week"), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))

```

```{r instructor formattable, echo=FALSE}
improvement_formatter <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold", 
              color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
             x ~ icontext(ifelse(x == max(x), "star", ""), x))

indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))

indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3, 
                                align = c("l", rep("c", NROW(indiv_disp_3)-1)),
              list(`Season Percent` = color_bar("#FA614B"),
              `Season Percent`= improvement_formatter,
              `Adj Season Percent`= improvement_formatter)))
              
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```

```{r Plotting individual results over the season2, echo=FALSE, out.width = "100%"}
#Creating the individual plot.  
inst_indiv_plots = weekly_indiv_percent_plot %>% 
  ggplot(aes(x = factor(Week), y = Percent, color = Name))+
  geom_point()+
  geom_path(aes(x = as.factor(Week), y = Percent, color = Name, 
                group = Name))+
  ylim(c(0, 1)) +
  labs(x = "NFL Week", 
       y = "Correct Percentage", 
       title = "Weekly Individual Correct Percentage")+
  facet_wrap(~Name)+
  theme_classic()+
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 18),
        axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```

```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
```

```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week

#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>% 
  rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_options(
    data_row.padding = px(3)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.

For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
 
 </font>


#### ESPN

<font size="4">

We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
 
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.

</font>

Row
--------------------------------------

### Win percentage for the week

```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Season Win Percentage

```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```

### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```

### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```

Row
--------------------------------------

### 

```{r}
inst_group_table
```

### 

```{r}
ggplotly(inst_group_season_plot) %>% 
  layout(title = list(y = .93, xref = "plot"),
         margin = list(t = 40))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

### Individual Plots
```{r, out.width="100%"}
season_leaderboard
```

### Season Leaderboard
```{r, out.width="100%"}
ggplotly(inst_indiv_plots)
```

Data
==========================================================================

```{r}
datatable(
  inst.data, extensions = 'Buttons', options = list(
    dom = 'Blfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
    lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
  )
)
```